home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / misc / math / acechan_101.lha / Acechan / Acechan.PAS < prev    next >
Pascal/Delphi Source File  |  1995-04-26  |  6KB  |  209 lines
  1. (*****************************************************************************)
  2. (* Acechan -- Produces data files which contain random data spread info.     *)
  3. (* (c)1995 Lee "Wangi" Kindness                                              *)
  4. (*****************************************************************************)
  5. Program Acechan;
  6.  
  7. Uses
  8.     Exec, AmigaDos, Amiga;
  9.  
  10. Const
  11.     { Version string }
  12.     VERSTAG : String[31] = '$VER: Acechan 1.1 (26.04.95)'#13#10#0;
  13.  
  14. Type
  15.     tConfig = Record
  16.         cf_Outfile    : String; { name of file to output to          }
  17.         cf_Min,                 { minimum value of range             }
  18.         cf_Max,                 { maximum value in range             }
  19.         cf_Iterations,          { number of iterations               }
  20.         cf_dp         : LONG;   { number of decimal places in output }
  21.         cf_RawOnly    : Boolean;{ do the graphical representation?   }
  22.     End;
  23.  
  24. (*****************************************************************************)
  25. Function GetInput(VAR cfg : tConfig) : Boolean;
  26. { Get options from the command line, using Amiga functions }
  27.  
  28. Const
  29.     TEMP : String[61] = 'MINIMUM/N,MAXIMUM/N,ITERATIONS/N,DP/K/N,RAWONLY/S,OUTPUTFILE'#0;
  30.     OPT_MIN   = 0; { minimum value of range             }
  31.     OPT_MAX   = 1; { maximum value in range             }
  32.     OPT_ITER  = 2; { number of iterations               }
  33.     OPT_DP    = 3; { number of decimal places in output }
  34.     OPT_RAW   = 4;
  35.     OPT_FILE  = 5; { name of file to output to          }
  36.     rda : Array[OPT_MIN..OPT_FILE] Of Pointer = (NIL,NIL,NIL,NIL,NIL);
  37.  
  38. Var
  39.     RDArgs : pRDArgs;
  40.  
  41. Begin
  42.     GetInput := False;
  43.     { init cfg to defaults }
  44.     With cfg do Begin
  45.         cf_Min        := 1;
  46.         cf_Max        := 100;
  47.         cf_Iterations := 1000;
  48.         cf_dp         := 4;
  49.         cf_Outfile    := 'acechan.results';
  50.         cf_RawOnly    := False;
  51.     End;
  52.     RDArgs := ReadArgs(@TEMP[1], @rda, NIL);
  53.     If RDArgs <> NIL Then Begin
  54.         If rda[OPT_MIN] <> NIL Then
  55.             cfg.cf_Min := pLONG(rda[OPT_MIN])^;
  56.         If rda[OPT_MAX] <> NIL Then
  57.             cfg.cf_Max := pLONG(rda[OPT_MAX])^;
  58.         If rda[OPT_ITER] <> NIL Then
  59.             cfg.cf_Iterations := pLONG(rda[OPT_ITER])^;
  60.         If cfg.cf_Iterations < 10 Then
  61.             cfg.cf_Iterations := 10;
  62.         If rda[OPT_DP] <> NIL Then
  63.             cfg.cf_dp := pLONG(rda[OPT_DP])^;
  64.         If rda[OPT_RAW] <> NIL Then
  65.             cfg.cf_RawOnly := True;
  66.         If rda[OPT_FILE] <> NIL then
  67.             cfg.cf_Outfile := PtrToPas(rda[OPT_FILE]);
  68.         FreeArgs(RDArgs);
  69.         GetInput := True;
  70.     End;
  71. End;
  72.  
  73. (*****************************************************************************)
  74. Procedure DoIt(VAR cfg : tConfig);
  75.  
  76. (*****************)
  77. (*
  78.  * Set of functions to handle the 'array' type memory heap
  79.  * quite a lot of dodgy programming here :)
  80.  * If you are not an Amiga programmer then this might help:
  81.  *  LONG = LongInt;
  82.  *  pLONG = ^LONG;
  83.  *  AllocVec allocates memory from the system, MENF_CLEAR specifying that
  84.  *  it should be initilised to zeros, FreeVec will free this memory. I used
  85.  *  Amiga kernal functions rather than portable pascal ones because the pascal
  86.  *  ones use heap space...:(
  87.  *)
  88.  
  89. Function AllocBuf : pLONG;
  90. Begin
  91.     AllocBuf := AllocVec((Sizeof(LONG) * (cfg.cf_Max - cfg.cf_Min + 1)), MEMF_CLEAR);
  92.     (*
  93.      * Using standard pascal functions:
  94.      *
  95.      * VAR
  96.      *   p, e : pLONG;
  97.      *   n    : LONG;
  98.      *
  99.      * GetMem(p, (Sizeof(LONG) * (cfg.cf_Max - cfg.cf_Min + 1)));
  100.      * If p <> NIL Then Begin
  101.      *   For n := min to max Do Begin 
  102.      *     e := pLONG(LONG(buf) + ((n - cfg.cf_Min) * Sizeof(LONG)));
  103.      *     e^ := 0;
  104.      *   End;
  105.      * End;
  106.      * AllocBuf := p;
  107.      *)
  108. End;
  109.  
  110. Procedure FreeBuf(buf : pLONG);
  111. Begin
  112.     FreeVec(buf);
  113.     (*
  114.      * Using standard pascal functions:
  115.      *
  116.      * FreeMem(buf, (Sizeof(LONG) * (cfg.cf_Max - cfg.cf_Min + 1)));
  117.      *)
  118. End;
  119.  
  120. Procedure IncBuf(buf : pLONG; entry : LONG);
  121. Var
  122.     e : pLONG;
  123. Begin
  124.     e := pLONG(LONG(buf) + ((entry - cfg.cf_Min) * Sizeof(LONG)));
  125.     inc(e^);
  126. End;
  127.  
  128. Function AccessBuf(buf : pLONG; entry : LONG) : LONG;
  129. Var
  130.     e : pLONG;
  131. Begin
  132.     e := pLONG(LONG(buf) + ((entry - cfg.cf_Min) * Sizeof(LONG)));
  133.     AccessBuf := e^;
  134. End;
  135.  
  136. Function RandRange(min, max : LONG) : LONG;
  137. Begin
  138.     RandRange := Random(max - min + 1) + min;
  139. End;
  140.     
  141. (*****************)
  142.  
  143. Var
  144.     buf : pLONG;
  145.     n, num, y : LONG;
  146.     f : Text;
  147.     
  148. Begin
  149.     Randomize;
  150.     With cfg Do Begin
  151.         buf := AllocBuf;
  152.         If buf <> NIL Then begin
  153.             { generate the random spread }
  154.             For n := 1 To cf_Iterations do Begin
  155.                 num := RandRange(cf_Min, cf_Max);
  156.                 IncBuf(buf, num);
  157.             End;
  158.             { create the output file }
  159.             { Assign(f, cf_OutFile); }
  160.             {$I-} ReWrite(f, cf_Outfile); {$I+}
  161.             If IOResult = 0 Then Begin
  162.                 Writeln(f, 'data results file created by Acechan, ©Lee Kindness');
  163.                 { the raw data }
  164.                 Writeln(f);
  165.                 Writeln(f, 'RAW DATA:');
  166.                 Writeln(f);
  167.                 For n := cf_Min to cf_Max do
  168.                     Writeln(f, n:5,' : ',AccessBuf(buf, n):5,', ',((AccessBuf(buf, n)/cf_Iterations)*100):0:cf_dp,'%');
  169.                 If NOT cf_RawOnly Then Begin
  170.                     { the distribution 'curve' }
  171.                     Writeln(f);
  172.                     Writeln(f, 'DISTRIBUTED REPRESENTATION');
  173.                     Writeln(f);
  174.                     For n := cf_Min to cf_Max do Begin
  175.                         Write(f, n:5,' ');
  176.                         num := AccessBuf(buf, n);
  177.                         for y := 1 to num Do
  178.                             Write(f, '#');
  179.                         Writeln(f, '  ',num,' ',((AccessBuf(buf, n)/cf_Iterations)*100):0:cf_dp,'%');
  180.                     End;
  181.                 End;
  182.                 Writeln('Finished!!');
  183.                 Close(f);
  184.             End;
  185.             FreeBuf(buf);
  186.         End;
  187.     End;
  188. End;
  189.  
  190. (*****************************************************************************)
  191. Procedure Main;
  192.  
  193. Var
  194.     cfg : tConfig;
  195.  
  196. Begin
  197.     If pLibrary(SysBase)^.lib_Version >= 36 Then Begin
  198.         If pLibrary(DosBase)^.lib_Version >= 36 Then Begin
  199.             If GetInput(cfg) Then Begin
  200.                 DoIt(cfg);
  201.             End;
  202.         End Else Writeln('This program requires dos.library 36 (2.0)');
  203.     End Else Writeln('This program requires exec.library 36 (2.0)');
  204. End;
  205.  
  206. (*****************************************************************************)
  207. Begin main End.
  208.  
  209. (*****************************************************************************)